indiv smooths
William Norfolk
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages ---------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove sample error date + plant
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")#build a function here to make smooth frames so we don't repeat everything in huge loops
#FOR INDIVIDUAL FIGURES ONLY
make_n1_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")
return(smooth_n1)
}
make_n2_smooth_frame <- function(df){
smooth_n1 <- df %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")
return(smooth_n1)
}
#run frames through the functions
wrfa_smooth_n1 <- make_n1_smooth_frame(wrf_a_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n1 <- make_n1_smooth_frame(wrf_b_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n1 <- make_n1_smooth_frame(wrf_c_only_n1)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfa_smooth_n2 <- make_n2_smooth_frame(wrf_a_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfb_smooth_n2 <- make_n2_smooth_frame(wrf_b_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)wrfc_smooth_n2 <- make_n2_smooth_frame(wrf_c_only_n2)## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#get max date
maxdate <- max(wrfa_smooth_n1$date)
mindate <- min(wrfa_smooth_n1$date)Build loess smoothing figures figures
#COMBINED FIGURE ONLY
#create smoothing data frames
#n1
smooth_n1 <- only_n1 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N1")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)#n2
smooth_n2 <- only_n2 %>% select(-c(Facility)) %>%
group_by(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke) %>%
summarize(sum_copy_num_L = sum(mean_total_copies)) %>%
ungroup() %>%
mutate(log_sum_copies_L = log10(sum_copy_num_L)) %>%
mutate(target = "N2")## `summarise()` regrouping output by 'date', 'cases_cum_clarke', 'new_cases_clarke', 'X7_day_ave_clarke' (override with `.groups` argument)This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1a <- ggplot(wrfa_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 161)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2a <- ggplot(wrfa_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2a<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 161)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1a## `geom_smooth()` using formula 'y ~ x'
fit_n1a## [1] 11.49961 11.51576 11.53265 11.54980 11.56675 11.58303 11.59817 11.61172
## [9] 11.62411 11.63614 11.64788 11.65939 11.67073 11.68197 11.69317 11.70440
## [17] 11.71571 11.72718 11.73886 11.75081 11.76312 11.77582 11.78773 11.79775
## [25] 11.80613 11.81309 11.81887 11.82371 11.82785 11.83152 11.83495 11.83839
## [33] 11.84207 11.84622 11.85108 11.85689 11.86388 11.87230 11.88237 11.89433
## [41] 11.90841 11.92487 11.94392 11.96664 11.99370 12.02476 12.05949 12.09753
## [49] 12.13855 12.18220 12.22814 12.27602 12.32551 12.37625 12.42792 12.48016
## [57] 12.53263 12.58499 12.63689 12.68800 12.73797 12.78645 12.83312 12.87761
## [65] 12.92304 12.97229 13.02468 13.07951 13.13610 13.19377 13.25184 13.30960
## [73] 13.36639 13.42151 13.47428 13.52401 13.57002 13.61162 13.64812 13.67885
## [81] 13.70310 13.72021 13.72948 13.73023 13.72177 13.69847 13.65705 13.60032
## [89] 13.53112 13.45226 13.36656 13.27685 13.18596 13.09670 13.01191 12.93439
## [97] 12.86698 12.81250 12.77377 12.73823 12.69266 12.63893 12.57890 12.51443
## [105] 12.44739 12.37964 12.31304 12.24946 12.19075 12.13878 12.09541 12.06250
## [113] 12.04192 12.03151 12.02753 12.02943 12.03669 12.04879 12.06518 12.08534
## [121] 12.10875 12.13486 12.16315 12.19309 12.22414 12.25579 12.28749 12.31872
## [129] 12.34895 12.37765 12.40428 12.42832 12.44923 12.46649 12.48261 12.50032
## [137] 12.51944 12.53977 12.56112 12.58330 12.60612 12.62940 12.65293 12.67652
## [145] 12.69999 12.72315 12.74580 12.76775 12.78881 12.80928 12.82959 12.84981
## [153] 12.86998 12.89016 12.91039 12.93072 12.95120 12.97189 12.99282 13.01407
## [161] 13.03566#n2
extract_n2a## `geom_smooth()` using formula 'y ~ x'
fit_n2a## [1] 11.18217 11.29966 11.41558 11.52913 11.63952 11.74594 11.84760 11.94370
## [9] 12.03491 12.12254 12.20671 12.28753 12.36515 12.43969 12.51126 12.58001
## [17] 12.64605 12.70951 12.77052 12.82920 12.88569 12.94010 12.99073 13.03603
## [25] 13.07633 13.11193 13.14319 13.17041 13.19393 13.21408 13.23118 13.24556
## [33] 13.25754 13.26746 13.27563 13.28240 13.28807 13.29299 13.29747 13.30185
## [41] 13.30645 13.31159 13.31762 13.32209 13.32266 13.31975 13.31377 13.30515
## [49] 13.29432 13.28169 13.26768 13.25272 13.23723 13.22163 13.20634 13.19179
## [57] 13.17839 13.16657 13.15674 13.14934 13.14477 13.14347 13.14586 13.15235
## [65] 13.16347 13.17904 13.19845 13.22107 13.24630 13.27352 13.30211 13.33146
## [73] 13.36096 13.38998 13.41792 13.44415 13.46806 13.48904 13.50647 13.51973
## [81] 13.52821 13.53130 13.52838 13.51883 13.50204 13.47415 13.43315 13.38114
## [89] 13.32024 13.25257 13.18025 13.10539 13.03011 12.95652 12.88675 12.82290
## [97] 12.76710 12.72147 12.68811 12.65827 12.62256 12.58210 12.53801 12.49144
## [105] 12.44350 12.39534 12.34808 12.30285 12.26079 12.22301 12.19066 12.16486
## [113] 12.14675 12.13627 12.13218 12.13383 12.14057 12.15174 12.16670 12.18479
## [121] 12.20536 12.22776 12.25134 12.27544 12.29941 12.32260 12.34436 12.36404
## [129] 12.38098 12.39454 12.40405 12.40888 12.40836 12.40185 12.39209 12.38216
## [137] 12.37194 12.36131 12.35013 12.33827 12.32561 12.31203 12.29738 12.28155
## [145] 12.26440 12.24581 12.22565 12.20379 12.18010 12.15479 12.12813 12.10018
## [153] 12.07095 12.04048 12.00878 11.97590 11.94186 11.90668 11.87041 11.83305
## [161] 11.79466#assign fits to a vector
n1_trenda <- fit_n1a
n2_trenda <- fit_n2a
#extract y min and max for each
limits_n1a <- ggplot_build(extract_n1a)$data## `geom_smooth()` using formula 'y ~ x'limits_n1a <- as.data.frame(limits_n1a)
n1_ymina <- limits_n1a$ymin
n1_ymaxa <- limits_n1a$ymax
limits_n2a <- ggplot_build(extract_n2a)$data## `geom_smooth()` using formula 'y ~ x'limits_n2a <- as.data.frame(limits_n2a)
n2_ymina <- limits_n2a$ymin
n2_ymaxa <- limits_n2a$ymax
#reassign dataframes (just to be safe)
work_n1a <- wrfa_smooth_n1
work_n2a<- wrfa_smooth_n1
#fill in missing dates to smooth fits
work_n1a <- work_n1a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1a <- work_n1a$date
work_n2a <- work_n2a %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2a <- work_n2a$date
#create a new smooth dataframe to layer
smooth_frame_n1a <- data.frame(date_vec_n1a, n1_trenda, n1_ymina, n1_ymaxa)
smooth_frame_n2a <- data.frame(date_vec_n2a, n2_trenda, n2_ymina, n2_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1a, y = ~n1_trenda,
data = smooth_frame_n1a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a,
'</br> Median Log Copies: ', round(n1_trenda, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2a, y = ~n2_trenda,
data = smooth_frame_n2a,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a,
'</br> Median Log Copies: ', round(n2_trenda, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1a, ymin = ~n1_ymina, ymax = ~n1_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n1_ymina, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2a, ymin = ~n2_ymina, ymax = ~n2_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2a, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(n2_ymina, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_ymina), yend = ~max(n1_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfa_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_a## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.save(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#n1 extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1b <- ggplot(wrfb_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 161)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2b <- ggplot(wrfb_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2b<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 161)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1b## `geom_smooth()` using formula 'y ~ x'
fit_n1b## [1] 11.36423 11.39726 11.43079 11.46411 11.49650 11.52728 11.55574 11.58117
## [9] 11.60426 11.62625 11.64721 11.66721 11.68632 11.70462 11.72219 11.73910
## [17] 11.75542 11.77123 11.78661 11.80163 11.81636 11.83087 11.84415 11.85523
## [25] 11.86433 11.87166 11.87740 11.88178 11.88500 11.88725 11.88876 11.88971
## [33] 11.89032 11.89079 11.89132 11.89213 11.89341 11.89537 11.89822 11.90216
## [41] 11.90740 11.91414 11.92258 11.92861 11.92870 11.92394 11.91542 11.90425
## [49] 11.89151 11.87829 11.86568 11.85479 11.84669 11.84249 11.84328 11.85015
## [57] 11.86420 11.88794 11.92212 11.96511 12.01530 12.07109 12.13085 12.19297
## [65] 12.25584 12.31784 12.37736 12.43279 12.48251 12.52492 12.55838 12.59020
## [73] 12.62818 12.67149 12.71931 12.77084 12.82523 12.88168 12.93936 12.99745
## [81] 13.05512 13.11157 13.16596 13.21747 13.26529 13.30859 13.34655 13.37835
## [89] 13.40317 13.42019 13.42858 13.42753 13.41232 13.38050 13.33466 13.27738
## [97] 13.21124 13.13883 13.06272 12.98550 12.90975 12.83806 12.77300 12.71716
## [105] 12.67311 12.64345 12.61990 12.59291 12.56318 12.53138 12.49820 12.46432
## [113] 12.43042 12.39719 12.36532 12.33548 12.30835 12.28463 12.26500 12.25014
## [121] 12.23921 12.23084 12.22484 12.22108 12.21939 12.21961 12.22159 12.22516
## [129] 12.23017 12.23646 12.24387 12.25225 12.26142 12.27125 12.28156 12.29220
## [137] 12.30301 12.31384 12.32451 12.33489 12.34616 12.35946 12.37449 12.39098
## [145] 12.40863 12.42717 12.44632 12.46578 12.48528 12.50493 12.52508 12.54577
## [153] 12.56705 12.58896 12.61155 12.63487 12.65896 12.68386 12.70964 12.73632
## [161] 12.76397#n2
extract_n2b## `geom_smooth()` using formula 'y ~ x'
fit_n2b## [1] 11.05051 11.11629 11.18196 11.24676 11.30995 11.37079 11.42851 11.48237
## [9] 11.53311 11.58199 11.62911 11.67453 11.71833 11.76059 11.80140 11.84081
## [17] 11.87892 11.91581 11.95154 11.98619 12.01986 12.05260 12.08339 12.11128
## [25] 12.13650 12.15924 12.17972 12.19816 12.21476 12.22974 12.24332 12.25570
## [33] 12.26710 12.27772 12.28779 12.29751 12.30710 12.31677 12.32673 12.33719
## [41] 12.34837 12.36048 12.37374 12.38349 12.38577 12.38181 12.37286 12.36015
## [49] 12.34491 12.32838 12.31180 12.29639 12.28341 12.27407 12.26961 12.27128
## [57] 12.28031 12.29721 12.32094 12.35041 12.38451 12.42214 12.46222 12.50362
## [65] 12.54527 12.58605 12.62486 12.66062 12.69221 12.71854 12.73851 12.75885
## [73] 12.78644 12.82033 12.85960 12.90334 12.95060 13.00048 13.05203 13.10435
## [81] 13.15649 13.20754 13.25657 13.30265 13.34486 13.38228 13.41397 13.43902
## [89] 13.45649 13.46547 13.46502 13.45422 13.42890 13.38717 13.33153 13.26447
## [97] 13.18847 13.10603 13.01965 12.93181 12.84501 12.76173 12.68448 12.61574
## [105] 12.55801 12.51378 12.47403 12.42877 12.37903 12.32582 12.27016 12.21307
## [113] 12.15558 12.09870 12.04345 11.99085 11.94193 11.89769 11.85917 11.82739
## [121] 11.80005 11.77426 11.75012 11.72771 11.70714 11.68848 11.67185 11.65732
## [129] 11.64499 11.63496 11.62732 11.62215 11.61956 11.61964 11.62248 11.62817
## [137] 11.63680 11.64847 11.66328 11.68131 11.70248 11.72656 11.75340 11.78284
## [145] 11.81475 11.84897 11.88535 11.92375 11.96402 12.00626 12.05071 12.09738
## [153] 12.14630 12.19750 12.25099 12.30681 12.36497 12.42551 12.48844 12.55380
## [161] 12.62159#assign fits to a vector
n1_trendb <- fit_n1b
n2_trendb <- fit_n2b
#extract y min and max for each
limits_n1b <- ggplot_build(extract_n1b)$data## `geom_smooth()` using formula 'y ~ x'limits_n1b <- as.data.frame(limits_n1b)
n1_yminb <- limits_n1b$ymin
n1_ymaxb <- limits_n1b$ymax
limits_n2b <- ggplot_build(extract_n2b)$data## `geom_smooth()` using formula 'y ~ x'limits_n2b <- as.data.frame(limits_n2b)
n2_yminb <- limits_n2b$ymin
n2_ymaxb <- limits_n2b$ymax
#reassign dataframes (just to be safe)
work_n1b <- wrfb_smooth_n1
work_n2b<- wrfb_smooth_n1
#fill in missing dates to smooth fits
work_n1b <- work_n1b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1b <- work_n1b$date
work_n2b <- work_n2b %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2b <- work_n2b$date
#create a new smooth dataframe to layer
smooth_frame_n1b <- data.frame(date_vec_n1b, n1_trendb, n1_yminb, n1_ymaxb)
smooth_frame_n2b <- data.frame(date_vec_n2b, n2_trendb, n2_yminb, n2_ymaxb)
#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1b, y = ~n1_trendb,
data = smooth_frame_n1b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b,
'</br> Median Log Copies: ', round(n1_trendb, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2b, y = ~n2_trendb,
data = smooth_frame_n2b,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b,
'</br> Median Log Copies: ', round(n2_trendb, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1b, ymin = ~n1_yminb, ymax = ~n1_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n1_yminb, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2b, ymin = ~n2_yminb, ymax = ~n2_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2b, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(n2_yminb, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminb), yend = ~max(n1_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfb_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth #n1 extract # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_n1c <- ggplot(wrfc_smooth_n1, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n1c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 147)## Warning: Ignoring unknown aesthetics: outfit#n2 extract
extract_n2c <- ggplot(wrfc_smooth_n2, aes(x = date, y = log_sum_copies_L)) +
stat_smooth(aes(outfit=fit_n2c<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 147)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#n1
extract_n1c## `geom_smooth()` using formula 'y ~ x'
fit_n1c## [1] 11.18492 11.23820 11.29047 11.34156 11.39129 11.43949 11.48598 11.53060
## [9] 11.57351 11.61501 11.65515 11.69392 11.73137 11.76750 11.80235 11.83594
## [17] 11.86828 11.89940 11.92933 11.95808 11.98568 12.01215 12.03702 12.05989
## [25] 12.08090 12.10018 12.11787 12.13411 12.14902 12.16276 12.17544 12.18721
## [33] 12.19820 12.20855 12.21839 12.22787 12.23272 12.23024 12.22295 12.21332
## [41] 12.20386 12.19704 12.19537 12.19776 12.20131 12.20578 12.21091 12.21646
## [49] 12.22219 12.22785 12.23319 12.23796 12.24193 12.24485 12.24646 12.24653
## [57] 12.24481 12.25016 12.26794 12.29259 12.31860 12.34042 12.35252 12.34935
## [65] 12.33357 12.31197 12.28523 12.25405 12.21911 12.18109 12.14069 12.09858
## [73] 12.05547 12.01203 11.96895 11.92692 11.88662 11.84875 11.81191 11.77436
## [81] 11.73626 11.69778 11.65910 11.62039 11.58180 11.53625 11.47802 11.40940
## [89] 11.33266 11.25008 11.16395 11.07653 10.99010 10.90695 10.82935 10.75958
## [97] 10.69991 10.65263 10.62002 10.59067 10.55460 10.51623 10.47996 10.45020
## [105] 10.43134 10.42781 10.44355 10.47779 10.52779 10.59083 10.66418 10.74510
## [113] 10.83087 10.91876 11.00604 11.08997 11.16783 11.23690 11.29443 11.33771
## [121] 11.37427 11.41263 11.45151 11.48963 11.52572 11.55850 11.58973 11.62159
## [129] 11.65342 11.68457 11.71438 11.74219 11.76734 11.79202 11.81551 11.83624
## [137] 11.85591 11.87441 11.89161 11.90740 11.92166 11.93429 11.94451 11.95201
## [145] 11.95745 11.96146 11.96467#n2
extract_n2c## `geom_smooth()` using formula 'y ~ x'
fit_n2c## [1] 11.60275 11.61627 11.62964 11.64289 11.65604 11.66910 11.68208 11.69502
## [9] 11.70797 11.72096 11.73399 11.74705 11.76013 11.77321 11.78629 11.79936
## [17] 11.81240 11.82541 11.83837 11.85128 11.86413 11.87690 11.88988 11.90330
## [25] 11.91707 11.93109 11.94528 11.95955 11.97379 11.98793 12.00186 12.01550
## [33] 12.02875 12.04153 12.05374 12.06529 12.07457 12.08078 12.08506 12.08858
## [41] 12.09247 12.09788 12.10597 12.12039 12.14312 12.17278 12.20798 12.24733
## [49] 12.28946 12.33296 12.37645 12.41855 12.45788 12.49303 12.52264 12.54530
## [57] 12.55964 12.57377 12.59459 12.61888 12.64342 12.66498 12.68035 12.68630
## [65] 12.68304 12.67340 12.65808 12.63776 12.61315 12.58493 12.55379 12.52044
## [73] 12.48555 12.44984 12.41399 12.37869 12.34464 12.31253 12.26570 12.19337
## [81] 12.10509 12.01039 11.91883 11.83994 11.78325 11.74000 11.69534 11.64969
## [89] 11.60349 11.55715 11.51112 11.46583 11.42169 11.37915 11.33863 11.30056
## [97] 11.26537 11.23350 11.20536 11.19153 11.19763 11.21668 11.24169 11.26569
## [105] 11.28170 11.28273 11.26856 11.24479 11.21325 11.17573 11.13405 11.09002
## [113] 11.04544 11.00213 10.96189 10.92654 10.89787 10.87771 10.86786 10.87013
## [121] 10.87702 10.88181 10.88747 10.89695 10.91323 10.93927 10.97189 11.00653
## [129] 11.04406 11.08533 11.13120 11.18253 11.24020 11.30171 11.36760 11.43958
## [137] 11.51587 11.59656 11.68176 11.77156 11.86606 11.96536 12.07049 12.18190
## [145] 12.29880 12.42039 12.54588#assign fits to a vector
n1_trendc <- fit_n1c
n2_trendc <- fit_n2c
#extract y min and max for each
limits_n1c <- ggplot_build(extract_n1c)$data## `geom_smooth()` using formula 'y ~ x'limits_n1c <- as.data.frame(limits_n1c)
n1_yminc <- limits_n1c$ymin
n1_ymaxc <- limits_n1c$ymax
limits_n2c <- ggplot_build(extract_n2c)$data## `geom_smooth()` using formula 'y ~ x'limits_n2c <- as.data.frame(limits_n2c)
n2_yminc <- limits_n2c$ymin
n2_ymaxc <- limits_n2c$ymax
#reassign dataframes (just to be safe)
work_n1c <- wrfc_smooth_n1
work_n2c <- wrfc_smooth_n1
#fill in missing dates to smooth fits
work_n1c <- work_n1c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n1c <- work_n1c$date
work_n2c <- work_n2c %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_n2c <- work_n2c$date
#create a new smooth dataframe to layer
smooth_frame_n1c <- data.frame(date_vec_n1c, n1_trendc, n1_yminc, n1_ymaxc)
smooth_frame_n2c <- data.frame(date_vec_n2c, n2_trendc, n2_yminc, n2_ymaxc)
#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_n1c, y = ~n1_trendc,
data = smooth_frame_n1c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c,
'</br> Median Log Copies: ', round(n1_trendc, digits = 2),
'</br> Target: N1'),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_lines(x = ~date_vec_n2c, y = ~n2_trendc,
data = smooth_frame_n2c,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c,
'</br> Median Log Copies: ', round(n2_trendc, digits = 2),
'</br> Target: N2'),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_ribbons(x ~date_vec_n1c, ymin = ~n1_yminc, ymax = ~n1_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n1c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n1_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n1_yminc, digits = 2),
'</br> Target: N1'),
name = "",
line = list(color = '#1B9E77')) %>%
plotly::add_ribbons(x ~date_vec_n2c, ymin = ~n2_yminc, ymax = ~n2_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_n2c, #leaving in case we want to change
'</br> Max Log Copies: ', round(n2_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(n2_yminc, digits = 2),
'</br> Target: N2'),
name = "",
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(n1_yminc), yend = ~max(n1_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n1,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65)) %>%
plotly::add_markers(x = ~date, y = ~log_sum_copies_L,
data = wrfc_smooth_n2,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_sum_copies_L, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(smooth_frame_n1a, file = "./plotly_objs/smooth_frame_n1a.rda")
save(smooth_frame_n2a, file = "./plotly_objs/smooth_frame_n2a.rda")
save(smooth_frame_n1b, file = "./plotly_objs/smooth_frame_n1b.rda")
save(smooth_frame_n2b, file = "./plotly_objs/smooth_frame_n2b.rda")
save(smooth_frame_n1c, file = "./plotly_objs/smooth_frame_n1c.rda")
save(smooth_frame_n2c, file = "./plotly_objs/smooth_frame_n2c.rda")save(date_vec_n1a, file = "./plotly_objs/date_vec_n1a.rda")
save(date_vec_n2a, file = "./plotly_objs/date_vec_n2a.rda")
save(date_vec_n1b, file = "./plotly_objs/date_vec_n1b.rda")
save(date_vec_n2b, file = "./plotly_objs/date_vec_n2b.rda")
save(date_vec_n1c, file = "./plotly_objs/date_vec_n1c.rda")
save(date_vec_n2c, file = "./plotly_objs/date_vec_n2c.rda")save(n1_ymina, file = "./plotly_objs/n1_ymina.rda")
save(n1_ymaxa, file = "./plotly_objs/n1_ymaxa.rda")
save(n2_ymina, file = "./plotly_objs/n2_ymina.rda")
save(n2_ymaxa, file = "./plotly_objs/n2_ymaxa.rda")
save(n1_yminb, file = "./plotly_objs/n1_yminb.rda")
save(n1_ymaxb, file = "./plotly_objs/n1_ymaxb.rda")
save(n2_yminb, file = "./plotly_objs/n2_yminb.rda")
save(n2_ymaxb, file = "./plotly_objs/n2_ymaxb.rda")
save(n1_yminc, file = "./plotly_objs/n1_yminc.rda")
save(n1_ymaxc, file = "./plotly_objs/n1_ymaxc.rda")
save(n2_yminc, file = "./plotly_objs/n2_yminc.rda")
save(n2_ymaxc, file = "./plotly_objs/n2_ymaxc.rda")